home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Integer.mlp < prev    next >
Encoding:
Text File  |  1996-07-03  |  3.5 KB  |  108 lines  |  [TEXT/R*ch]
  1. (* Integer -- new basis 1995-03-19 *)
  2.  
  3. type int = int
  4.  
  5. #include "../config/m.h"
  6. #ifdef SIXTYFOUR
  7. (* 64-bit architecture: *)
  8. val precision = SOME 63;
  9. val minint    = SOME ~4611686018427387904;
  10. val maxint    = SOME  4611686018427387903;
  11. #else
  12. (* 32-bit architecture: *)
  13. val precision = SOME 31;    
  14. val minint    = SOME ~1073741824;
  15. val maxint    = SOME  1073741823;
  16. #endif
  17.  
  18. local 
  19.     open StringCvt
  20.     (* Below, 48 = Char.ord #"0" and 55 = Char.ord #"A" - 10. *)
  21.     fun decval c = Char.ord c - 48;
  22.     fun hexval c = 
  23.     if #"0" <= c andalso c <= #"9" then Char.ord c - 48
  24.     else (Char.ord c - 55) rem 32;
  25.     fun prhex i = if i < 10 then Char.chr(i + 48) else Char.chr(i + 55)
  26.     fun skipWSget getc source = getc (skipWS {getc=getc} source)
  27.  
  28.     fun conv radix i = 
  29.     let fun h 0 res = res
  30.           | h n res = h (n quot radix) (prhex (n rem radix) :: res)
  31.         fun tostr n = h (n quot radix) [prhex (n rem radix)]
  32.     in String.implode (if i < 0 then #"~" :: tostr (~i) else tostr i) end
  33. in
  34.     fun scan radix {getc} source =
  35.     let open StringCvt
  36.         val (isDigit, factor) = 
  37.         case radix of
  38.             BIN => (fn c => (#"0" <= c andalso c <= #"1"),  2)
  39.           | OCT => (fn c => (#"0" <= c andalso c <= #"7"),  8)
  40.           | DEC => (Char.isDigit,                          10)
  41.           | HEX => (Char.isHexDigit,                       16)
  42.         fun dig1 sgn NONE             = NONE
  43.           | dig1 sgn (SOME (c, rest)) = 
  44.         let fun digr res src = 
  45.             case getc src of
  46.             NONE           => SOME (sgn * res, src)
  47.               | SOME (c, rest) => 
  48.                 if isDigit c then 
  49.                 digr (factor * res + hexval c) rest
  50.                 else 
  51.                 SOME (sgn * res, src)
  52.         in if isDigit c then digr (hexval c) rest else NONE end
  53.         fun sign NONE                = NONE
  54.           | sign (SOME (#"~", rest)) = dig1 ~1 (getc rest)
  55.           | sign (SOME (#"-", rest)) = dig1 ~1 (getc rest)
  56.           | sign (SOME (#"+", rest)) = dig1  1 (getc rest)
  57.           | sign inp                 = dig1  1 inp        
  58.     in sign (skipWSget getc source) end;
  59.         
  60.     fun fmt BIN = conv 2
  61.       | fmt OCT = conv 8
  62.       | fmt DEC = conv 10
  63.       | fmt HEX = conv 16
  64.     
  65.     val toString = conv 10
  66.     val fromString = scanString (scan DEC)
  67. end
  68.  
  69. fun ceil r = ~(floor (~r));
  70. val floor   = floor;
  71. fun trunc r = if r >= 0.0 then floor r else ceil r;
  72.  
  73. (* The following is rather inefficient, but correct.  A faster method
  74.    exists, see src/sml-nj/boot/math.sml, but that does not work on a
  75.    number such as 1000001.4999, which gets rounded to 1000002.0 *)
  76. fun round r = 
  77.     let prim_val andb_ : int -> int -> int = 2 "and";
  78.     val rf = floor r
  79.     val df = r - real rf 
  80.     in 
  81.     if df > 0.5 orelse df = 0.5 andalso andb_ 1 rf = 1 then rf + 1 
  82.     else rf 
  83.     end
  84. val real    = real;
  85.  
  86. val ~       : int -> int        = ~;
  87. val op *    : int * int -> int  = op *;
  88. val op div  : int * int -> int  = op div;
  89. val op mod  : int * int -> int  = op mod;
  90. val op quot : int * int -> int  = op quot;
  91. val op rem  : int * int -> int  = op rem;
  92. val op +    : int * int -> int  = op +;
  93. val op -    : int * int -> int  = op -;
  94. val op >    : int * int -> bool = op >;
  95. val op >=   : int * int -> bool = op >=;
  96. val op <    : int * int -> bool = op <;
  97. val op <=   : int * int -> bool = op <=;
  98. val abs     : int -> int = abs;
  99. fun min (x, y) = if x < y then x else y : int;
  100. fun max (x, y) = if x < y then y else x : int;
  101. fun sign i = if i > 0 then 1 else if i < 0 then ~1 else 0;
  102. fun compare (x, y: int) = if x<y then LESS else if x>y then GREATER else EQUAL;
  103.  
  104. fun sameSign (i, j) = sign i = sign j;
  105.  
  106. fun toDefault   i   = i;
  107. fun fromDefault i   = i;
  108.